codigoTFG
Jorge de Andrés
12 de enero de 2019
Lo primero que tengo que hacer es importar el dataset que he creado
dataset <- read.csv("C:/Users/jorge/Desktop/Documentos Clase/Universidad/4ºCarrera/1er Cuatrimestre/Inteligencia Artificial/Trabajo Fin de Asignatura/datos.txt", header = TRUE)Ahora lo que hago es pasarlo a una matriz, quitando tanto el nombre (que no me interesa) como la etiqueta (que no la necesito por ahora)
matriz.pacientes.etiquetas <- dataset[, -1]
matriz.pacientes.datos <- matriz.pacientes.etiquetas[, -25]Análisis Exploratorio
Primero compruebo que todos los datos tienen un tipo correcto.
sapply(matriz.pacientes.datos, class)## edad sex rel_ctxo_rel_mala rel_ctxo_trauma
## "integer" "integer" "integer" "integer"
## rel_ctxo_buena ed_perm ed_norm ed_estr
## "integer" "integer" "integer" "integer"
## resil_ba resil_me resil_al pen_dic
## "integer" "integer" "integer" "integer"
## gen_ex etiq fil_men max_min
## "integer" "integer" "integer" "integer"
## conc_arb pseu_res deb raz_emo
## "integer" "integer" "integer" "integer"
## inhib asert agres impuls
## "integer" "integer" "integer" "integer"Veo la media de la edad de los pacientes y el rango en el que se mueve
mean(matriz.pacientes.datos[, 1])## [1] 26.46269range(matriz.pacientes.datos[, 1])## [1] 13 52Voy a ver estos datos gráficamente:
#install.packages("ggplot2")
library("ggplot2")## Warning: package 'ggplot2' was built under R version 3.5.2qplot(1, matriz.pacientes.datos[, 1], xlab = "Pacientes", ylab = "Edad", geom="boxplot")
Finalmente, veo un resúmen de cada columna
summary(matriz.pacientes.datos)## edad sex rel_ctxo_rel_mala rel_ctxo_trauma
## Min. :13.00 Min. :0.000 Min. :0.0000 Min. :0.0000
## 1st Qu.:19.50 1st Qu.:0.000 1st Qu.:0.0000 1st Qu.:0.0000
## Median :25.00 Median :0.000 Median :0.0000 Median :0.0000
## Mean :26.46 Mean :0.209 Mean :0.1343 Mean :0.3582
## 3rd Qu.:30.50 3rd Qu.:0.000 3rd Qu.:0.0000 3rd Qu.:1.0000
## Max. :52.00 Max. :1.000 Max. :1.0000 Max. :1.0000
## rel_ctxo_buena ed_perm ed_norm ed_estr
## Min. :0.0000 Min. :0.0000 Min. :0.0000 Min. :0.0000
## 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.:0.0000
## Median :1.0000 Median :0.0000 Median :0.0000 Median :0.0000
## Mean :0.5075 Mean :0.2836 Mean :0.4925 Mean :0.2239
## 3rd Qu.:1.0000 3rd Qu.:1.0000 3rd Qu.:1.0000 3rd Qu.:0.0000
## Max. :1.0000 Max. :1.0000 Max. :1.0000 Max. :1.0000
## resil_ba resil_me resil_al pen_dic
## Min. :0.0000 Min. :0.0000 Min. :0.00000 Min. :0.0000
## 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.:0.00000 1st Qu.:1.0000
## Median :1.0000 Median :0.0000 Median :0.00000 Median :1.0000
## Mean :0.5672 Mean :0.4179 Mean :0.01493 Mean :0.8955
## 3rd Qu.:1.0000 3rd Qu.:1.0000 3rd Qu.:0.00000 3rd Qu.:1.0000
## Max. :1.0000 Max. :1.0000 Max. :1.00000 Max. :1.0000
## gen_ex etiq fil_men max_min
## Min. :0.0000 Min. :0.0000 Min. :0.000 Min. :0.0000
## 1st Qu.:1.0000 1st Qu.:0.5000 1st Qu.:1.000 1st Qu.:1.0000
## Median :1.0000 Median :1.0000 Median :1.000 Median :1.0000
## Mean :0.9552 Mean :0.7463 Mean :0.791 Mean :0.9701
## 3rd Qu.:1.0000 3rd Qu.:1.0000 3rd Qu.:1.000 3rd Qu.:1.0000
## Max. :1.0000 Max. :1.0000 Max. :1.000 Max. :1.0000
## conc_arb pseu_res deb raz_emo
## Min. :0.0000 Min. :0.0000 Min. :0.0000 Min. :0.000
## 1st Qu.:1.0000 1st Qu.:0.0000 1st Qu.:1.0000 1st Qu.:1.000
## Median :1.0000 Median :1.0000 Median :1.0000 Median :1.000
## Mean :0.9851 Mean :0.5075 Mean :0.9403 Mean :0.791
## 3rd Qu.:1.0000 3rd Qu.:1.0000 3rd Qu.:1.0000 3rd Qu.:1.000
## Max. :1.0000 Max. :1.0000 Max. :1.0000 Max. :1.000
## inhib asert agres impuls
## Min. :0.0000 Min. :0.0000 Min. :0.000 Min. :0.0000
## 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.:0.000 1st Qu.:0.0000
## Median :1.0000 Median :0.0000 Median :0.000 Median :1.0000
## Mean :0.6567 Mean :0.1343 Mean :0.209 Mean :0.6119
## 3rd Qu.:1.0000 3rd Qu.:0.0000 3rd Qu.:0.000 3rd Qu.:1.0000
## Max. :1.0000 Max. :1.0000 Max. :1.000 Max. :1.0000Como se puede ver, los datos de los pacientes están muy distanciados, y además su media es muy alta. Así, la media de la edad difiere enormemente del resto de valores de la matriz. Debido a ello, debemos de hacer un preprocesado de los datos del problema.
Preparación de los datos
Como he comentado antes, Lo que voy a hacer ahora es un centrado y escalado de los datos de la matriz. De esta manera, la red neuronal no tendrá ningún valor que destaque especialmente y con ello no dará de inicio más peso a unos valores que a otros, ya que no lo buscamos.
Lo primero que hacemos es importar la librería caret
#install.packages("caret")
library(caret)## Warning: package 'caret' was built under R version 3.5.2## Loading required package: latticeAhora hacemos un centrado y escalado de los datos, ya que la edad no sigue el rango del resto de valores, y distorsionaría la predicción
preObjeto <- preProcess(matriz.pacientes.datos, method=c("center", "scale")) # Quiero hacer un centrado y escalado
matriz.pacientes.datos.centscal <- predict(preObjeto, matriz.pacientes.datos) # Obtengo los valores en la matriz centscalDespués del preprocesado, aunque con los datos no preprocesados, voy a hacer la visualización de algunas relaciones entre variables, de tal manera que podamos ver gráficamente algunos aspectos interesantes:
Visualización de Datos
Ahora voy a sacar un plot para ver la relación entre la edad y el sexo de las personas que están en consulta
plot(matriz.pacientes.datos[,1], matriz.pacientes.datos[,2], xlab="Edad", ylab="Sexo (0 - mujer, 1 - hombre)", main="Edad & Sexo");
Otro plot para ver la correlación entre ser agresivo y ser impulsivo
#install.packages("hexbin")
#install.packages("RColorBrewer")
library(hexbin)
library(RColorBrewer)
rf <- colorRampPalette(rev(brewer.pal(4,'Spectral')))
df <- data.frame(matriz.pacientes.datos[, 23], matriz.pacientes.datos[, 24])
h <- hexbin(df)
plot(h, colramp=rf, xlab="Agresivo", ylab="Impulsivo", main="Agresivo Vs Impulsivo")
Otro plot similar para ver la relación de ser inhibido e impulsivo
df <- data.frame(matriz.pacientes.datos[, 21], matriz.pacientes.datos[, 24])
h <- hexbin(df)
plot(h, colramp=rf, xlab="Inhibido", ylab="Impulsivo", main="Inhibido Vs Impulsivo")
Voy a ver la relación entre el razonamiento emocional (actuar según tus sentimientos) y la impulsividad
df <- data.frame(matriz.pacientes.datos[, 20], matriz.pacientes.datos[, 24])
h <- hexbin(df)
plot(h, colramp=rf, xlab="Razonamiento Emocional", ylab="Impulsivo", main="Razonamiento Emocional Vs Impulsivo")
Ahora quiero sacar una relación entre ser agresivo y ver el grupo en el que están
rf <- colorRampPalette(rev(brewer.pal(4,'Spectral')))
df <- data.frame(matriz.pacientes.datos[, 23], matriz.pacientes.etiquetas[, 25])
h <- hexbin(df)
plot(h, colramp=rf, xlab="Agresivo", ylab="Grupo", main="Agresivo Y Grupo Real")
Voy a hacer lo mismo con la impulsividad
rf <- colorRampPalette(rev(brewer.pal(4,'Spectral')))
df <- data.frame(matriz.pacientes.datos[, 24], matriz.pacientes.etiquetas[, 25])
h <- hexbin(df)
plot(h, colramp=rf, xlab="Impulsivo", ylab="Grupo", main="Impulsivo y Grupo Real")
De estas gráficas estamos obteniendo información realmente interesante antes de la predicción de los datos. He preferido hacer gráficas en 2D porque las gráficas en 3D son mucho más difíciles de interpretar que estas bonitas gráficas en 2D
Vamos a ver la correlación que tienen mis variables
res <- cor(matriz.pacientes.datos[, 1:24], method = "spearman") # Por mi tipo de datos, hacemos la correlación por spearman
options(width = 100)
res.round <- round(res, 2)Como saca una tabla enorme, lo que voy a hacer es usar una librería que me da una función para sacar de una forma bonita las correlaciones entre las variables.
#install.packages("corrplot")
library(corrplot)## corrplot 0.84 loadedcorrplot(res.round, method="circle")
Como podemos ver, por ejemplo, resiliencia baja y media tienen una correlación de -1, ya que si hay una no hay la otra y viceversa. Esto pasa igual con las relaciones entre contexto, ya que buena - trauma, trauma - mala, mala - buena tienen que ser inversas.
Ahora voy a sacar un PCA para ver la importancia de las variables:
#install.packages("FactoMineR")
library("FactoMineR")## Warning: package 'FactoMineR' was built under R version 3.5.2#devtools::install_github("kassambara/factoextra")Para los cálculos, uso la matriz con el centrado y escalado ya hechos
resultado.pca <- PCA(matriz.pacientes.datos.centscal, graph = FALSE)
#Con la siguiente línea podemos ver que podemos hacer con esto calculado
print(resultado.pca)## **Results for the Principal Component Analysis (PCA)**
## The analysis was performed on 67 individuals, described by 24 variables
## *The results are available in the following objects:
##
## name description
## 1 "$eig" "eigenvalues"
## 2 "$var" "results for the variables"
## 3 "$var$coord" "coord. for the variables"
## 4 "$var$cor" "correlations variables - dimensions"
## 5 "$var$cos2" "cos2 for the variables"
## 6 "$var$contrib" "contributions of the variables"
## 7 "$ind" "results for the individuals"
## 8 "$ind$coord" "coord. for the individuals"
## 9 "$ind$cos2" "cos2 for the individuals"
## 10 "$ind$contrib" "contributions of the individuals"
## 11 "$call" "summary statistics"
## 12 "$call$centre" "mean of the variables"
## 13 "$call$ecart.type" "standard error of the variables"
## 14 "$call$row.w" "weights for the individuals"
## 15 "$call$col.w" "weights for the variables"Nos interesa ver los eigenvalues, que son los que presentarán la cantidad de varianza que aportan las variables:
eigenvalues.PCA <- resultado.pca$eig
eigenvalues.PCA## eigenvalue percentage of variance cumulative percentage of variance
## comp 1 3.896946e+00 1.623727e+01 16.23727
## comp 2 3.348839e+00 1.395349e+01 30.19077
## comp 3 2.189584e+00 9.123265e+00 39.31403
## comp 4 2.044520e+00 8.518834e+00 47.83287
## comp 5 1.737900e+00 7.241252e+00 55.07412
## comp 6 1.521215e+00 6.338397e+00 61.41252
## comp 7 1.374042e+00 5.725176e+00 67.13769
## comp 8 1.079722e+00 4.498843e+00 71.63653
## comp 9 9.591848e-01 3.996603e+00 75.63314
## comp 10 9.311536e-01 3.879807e+00 79.51294
## comp 11 8.644377e-01 3.601824e+00 83.11477
## comp 12 8.099267e-01 3.374695e+00 86.48946
## comp 13 6.658121e-01 2.774217e+00 89.26368
## comp 14 5.935233e-01 2.473014e+00 91.73669
## comp 15 4.698651e-01 1.957771e+00 93.69447
## comp 16 4.632196e-01 1.930082e+00 95.62455
## comp 17 3.922638e-01 1.634433e+00 97.25898
## comp 18 2.445767e-01 1.019069e+00 98.27805
## comp 19 2.251255e-01 9.380229e-01 99.21607
## comp 20 1.497768e-01 6.240699e-01 99.84014
## comp 21 3.836592e-02 1.598580e-01 100.00000
## comp 22 1.475982e-31 6.149926e-31 100.00000
## comp 23 3.435901e-32 1.431625e-31 100.00000
## comp 24 4.473592e-33 1.863997e-32 100.00000Como se puede comprobar, de las 24 variables (componentes) que tenemos, la mitad de la varianza la conseguimos con aproximadamente 5 variables. También se puede ver que a parti de las 17 variables prácticamente no hay un aumento de la varianza. En el caso de un problema grande, sería interesante la eliminación de algunas de las variables, para dejar un dataset más pequeño con el que poder trabajar. En nuestro caso, nuestro problema es pequeño, y además las variables están escogidas a mano, por lo que no haré una reducción del dataset.
Ahora, para completar este apartado de PCA, lo que voy a hacer es sacar la gráfica de la varianza acumulada con los valores anteriores:
#install.packages("factoextra")
library("factoextra")## Warning: package 'factoextra' was built under R version 3.5.2## Welcome! Related Books: `Practical Guide To Cluster Analysis in R` at https://goo.gl/13EFCZplotPCA <- fviz_screeplot(resultado.pca, ncp=24)
plot(plotPCA)
Ahora voy a sacar un “Factor Map” de las variables. Esto lo puedo hacer gracias a las coordenadas que me da una de las variables tras hacer el PCA. Así, voy primero a ver la tabla y luego voy a sacar el mapa:
resultado.pca$var$coord## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5
## edad 0.007991017 0.66451493 0.19586260 0.007841951 0.02805228
## sex -0.447913174 -0.11533971 0.10245651 0.057192465 0.11492883
## rel_ctxo_rel_mala -0.234645431 0.31242667 0.16869825 0.565844840 -0.35019764
## rel_ctxo_trauma -0.417381244 0.11742230 -0.21001522 -0.136376092 0.34458474
## rel_ctxo_buena 0.560339731 -0.32571613 0.08634947 -0.255162421 -0.09161091
## ed_perm -0.553915390 -0.34063941 0.23874352 0.241008740 -0.33289199
## ed_norm 0.195717913 0.33691768 -0.54551596 0.069259334 0.57202966
## ed_estr 0.364218109 -0.03574847 0.39611368 -0.343671891 -0.32610946
## resil_ba 0.051112365 -0.85796492 0.20216746 -0.039061871 0.21241196
## resil_me -0.074743641 0.80191325 -0.29969255 0.153867444 -0.18199709
## resil_al 0.095173049 0.24393919 0.39293737 -0.466258490 -0.12766293
## pen_dic 0.311964031 -0.08886036 0.58511514 0.186141485 0.18431008
## gen_ex 0.595148670 -0.10912103 0.08286185 0.282531851 0.16255400
## etiq 0.499365039 -0.45912251 -0.17281954 0.173075672 0.14741419
## fil_men 0.059354773 -0.07552104 0.31916448 -0.355626217 0.39559535
## max_min 0.524773891 0.12325520 0.31096225 0.378637566 -0.01643986
## conc_arb 0.645068936 0.21765964 0.22093906 0.466271365 0.04542650
## pseu_res 0.443972323 0.22314014 -0.11950533 -0.176808668 0.43526671
## deb 0.484524206 0.38834362 0.18502988 0.268386661 0.11400205
## raz_emo -0.251049993 -0.27394959 -0.20413968 0.433531845 0.02071493
## inhib 0.563528317 -0.27772651 -0.48974596 0.018053816 -0.35529325
## asert -0.126327074 0.57800397 0.34437650 -0.343315766 0.04021108
## agres -0.591302668 -0.14500954 0.29219301 0.239210208 0.43081535
## impuls -0.289816690 0.01403726 0.32193103 0.339678159 0.27914883Como se puede ver, me está poniendo mis 24 variables en 5 dimensiones, con unas coordenadas concretas. Ahora, lo que voy a hacer, es representarlo. Con esta representación podré sacar algunas conclusiones:
fviz_pca_var(resultado.pca)
Con esto puedo sacar conclusiones al igual que con el gran gráfico de correlaciones de variables, solo que esta representación está intencionada para más de 2 dimensiones.
Puedo ver algunas de las conclusiones fáciles que saqué anteriormente, como que resiliencia media es contraria a baja, o que la relación con el contexto de trauma y mala son contrarias a buena.
Otras relaciones también puedo ver, como que los deberías y el razonamiento emocional parecen ser ciertamente contrarios, o que el filtro mental no depende de prácticamente nada ya que está en todo el centro.
También es importante ver como, mediante dos componentes principales (dos dimensiones), solo estoy explicando un del 30,2% del total, lo que es muy poco. Por unirlo con los gráficos anteriores, estas dos componentes que se han elegido como x e y son las dos variables que más varianza (y por lo tanto, explicación) tenían en el gráfico de barras anterior.
Ahora mi siguiente paso es sacar un gráfico de los individuos, para ver donde están colocados en este sistema:
head(resultado.pca$ind$coord) # Solo saco los primeros para no ocupar demasiado espacio## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5
## 1 -2.3243690 2.147815 -1.1849618 2.4481512 -0.7586328
## 2 2.4647257 -1.262473 0.2217190 -1.1784100 -1.4473760
## 3 0.6387125 -2.080331 -0.1818521 0.7676582 -2.0265412
## 4 -1.9384395 -1.832160 1.4628618 1.1820858 1.1852182
## 5 2.0986406 0.262897 -0.2150152 -0.7686587 -1.2663434
## 6 1.1578332 -1.323444 -0.8453683 0.9774806 -0.1661987Ahora, tras ver que todos mis individuos tienen unas ciertas coordenadas, vamos a representarlos gráficamente:
fviz_pca_ind(resultado.pca)
Se puede ver que la mayoría de los pacientes están en torno al centro, mientras que tenemos un outlayer, que es el número 27.
Modelos de Inteligencia Artificial supervisados
Ahora vamos a importar la librería nnet, que nos sirve para hacer perceptrones
#install.packages("nnet")
library(nnet)Ahora lo que hago es coger un conjunto muy grande de los datos para hacer el entrenamiento
conjuntoEntrenamiento <- sample(1:67, 55)1 NEURONA
Lo que voy a hacer ahora es entrenar la red neuronal con diferente cantidad de neuronas,y voy a ir comparando el resultado…
SIN SOFTMAX
pacientes.1neu <- nnet( matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], class.ind( matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) , size=1 )## # weights: 33
## initial value 62.184121
## iter 10 value 38.148725
## iter 20 value 36.352890
## iter 30 value 36.107826
## iter 40 value 31.356627
## iter 50 value 31.083921
## iter 60 value 31.059300
## iter 70 value 29.929294
## iter 80 value 29.927421
## iter 90 value 29.793946
## iter 100 value 27.315656
## final value 27.315656
## stopped after 100 iterations#Una vez que lo tengo entrenado, lo que voy a hacer es calcular el error tanto en el entrenamiento como en el test de cada uno
pacientes.prediccion.1neu <- predict( pacientes.1neu, matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], type="raw" )
head(pacientes.prediccion.1neu) # Vemos las probabilidades de pertenencia de cada valor## 1 2 3 4
## 24 0.3870305 0.1288085 0.1935532 0.29028104
## 10 0.1254417 0.8752012 0.0000000 0.00579185
## 59 0.3870305 0.1288085 0.1935532 0.29028104
## 23 0.1254417 0.8752012 0.0000000 0.00579185
## 54 0.3870305 0.1288085 0.1935532 0.29028104
## 30 0.1254417 0.8752012 0.0000000 0.00579185# Ahora que los tengo todos entrenados, Determinamos cual es la máxima, es decir, la clase a la que hay que asignar los objetos
pacientes.prediccion.1neu.class <- apply( pacientes.prediccion.1neu, MARGIN=1, FUN='which.is.max')
pacientes.prediccion.1neu.class## 24 10 59 23 54 30 16 26 3 66 41 40 51 2 22 35 37 34 21 57 47 5 20 14 67 42 7 36 32 52 43 12 46
## 1 2 1 2 1 2 1 1 2 2 1 1 1 2 1 2 2 2 2 1 1 2 2 1 1 1 1 2 1 1 1 1 1
## 48 31 53 45 9 18 60 62 64 65 44 15 58 1 49 61 27 13 29 8 17 25
## 2 2 1 2 2 1 2 2 2 1 2 1 1 1 1 1 1 2 2 2 1 1# Lo visualizo en forma de tabla para ir viendo el error
table( pacientes.prediccion.1neu.class, matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) # Lo vemos en forma de tabla.##
## pacientes.prediccion.1neu.class 1 2 3 4
## 1 12 4 6 9
## 2 3 21 0 0#Calculo el acierto
sum( diag( table( pacientes.prediccion.1neu.class, matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) ) )/55 # Esta cuenta nos da el índice de acierto## [1] 0.6TEST
pacientes.prediccion.test.1neu <- predict( pacientes.1neu, matriz.pacientes.datos.centscal[-conjuntoEntrenamiento, 1:24], type="raw" )
pacientes.prediccion.test.1neu## 1 2 3 4
## 4 0.3870305 0.1288085 0.1935532 0.290281037
## 6 0.1254417 0.8752012 0.0000000 0.005791850
## 11 0.1254417 0.8752012 0.0000000 0.005791850
## 19 0.1254417 0.8752012 0.0000000 0.005791850
## 28 0.3869846 0.1288650 0.1932035 0.290166783
## 33 0.1254417 0.8752012 0.0000000 0.005791850
## 38 0.3870305 0.1288085 0.1935532 0.290281037
## 39 0.1254417 0.8752012 0.0000000 0.005791850
## 50 0.1256346 0.8747007 0.0000000 0.005820939
## 55 0.3870305 0.1288085 0.1935532 0.290281037
## 56 0.3870305 0.1288085 0.1935532 0.290281037
## 63 0.1254417 0.8752012 0.0000000 0.005791850pacientes.prediccion.test.1neu.class <- apply( pacientes.prediccion.test.1neu, MARGIN=1, FUN='which.is.max')
pacientes.prediccion.test.1neu.class## 4 6 11 19 28 33 38 39 50 55 56 63
## 1 2 2 2 1 2 1 2 2 1 1 2table( pacientes.prediccion.test.1neu.class , matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] )##
## pacientes.prediccion.test.1neu.class 1 2 3 4
## 1 2 0 1 2
## 2 0 5 1 1sum( diag( table( pacientes.prediccion.test.1neu.class, matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] ) ) )/12## [1] 0.5833333Lo voy a entrenar también con el SOFTMAX = true. Esto optimiza la verosimilitud, no el error cuadrático medio… ###################### CON SOFTMAX ##############################
pacientes.1neu.softmax <- nnet( matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], class.ind( matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) , size=1, softmax = T )## # weights: 33
## initial value 70.318237
## iter 10 value 52.010065
## iter 20 value 44.977146
## iter 30 value 43.341212
## iter 40 value 42.347804
## iter 50 value 41.636261
## iter 60 value 41.133894
## iter 70 value 41.020525
## iter 80 value 41.019288
## iter 90 value 40.650168
## iter 100 value 40.487065
## final value 40.487065
## stopped after 100 iterations#Una vez que lo tengo entrenado, lo que voy a hacer es calcular el error tanto en el entrenamiento como en el test de cada uno
pacientes.prediccion.1neu.softmax <- predict( pacientes.1neu.softmax, matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], type="raw" )
head(pacientes.prediccion.1neu.softmax) # Vemos las probabilidades de pertenencia de cada valor## 1 2 3 4
## 24 0.3079712 0.04816545 2.180539e-01 4.258095e-01
## 10 0.1175613 0.88243867 8.957335e-22 0.000000e+00
## 59 0.3079712 0.04816545 2.180539e-01 4.258095e-01
## 23 0.8123099 0.17316854 1.452158e-02 2.275984e-46
## 54 0.3079712 0.04816545 2.180539e-01 4.258095e-01
## 30 0.1175613 0.88243867 8.957335e-22 0.000000e+00# Ahora que los tengo todos entrenados, Determinamos cual es la máxima, es decir, la clase a la que hay que asignar los objetos
pacientes.prediccion.1neu.class.softmax <- apply( pacientes.prediccion.1neu.softmax, MARGIN=1, FUN='which.is.max')
pacientes.prediccion.1neu.class.softmax## 24 10 59 23 54 30 16 26 3 66 41 40 51 2 22 35 37 34 21 57 47 5 20 14 67 42 7 36 32 52 43 12 46
## 4 2 4 1 4 2 4 4 2 2 1 1 4 2 1 2 2 2 2 1 4 2 2 4 4 4 4 2 4 4 4 2 4
## 48 31 53 45 9 18 60 62 64 65 44 15 58 1 49 61 27 13 29 8 17 25
## 2 2 2 2 2 2 2 2 2 4 2 1 4 1 4 4 4 2 2 2 4 1# Lo visualizo en forma de tabla para ir viendo el error
table( pacientes.prediccion.1neu.class.softmax, matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) # Lo vemos en forma de tabla.##
## pacientes.prediccion.1neu.class.softmax 1 2 3 4
## 1 5 0 3 0
## 2 3 23 0 0
## 4 7 2 3 9#Calculo el acierto
sum( diag( table( pacientes.prediccion.1neu.class.softmax, matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) ) )/55 # Esta cuenta nos da el índice de acierto## [1] 0.5636364TEST
pacientes.prediccion.test.1neu.softmax <- predict( pacientes.1neu.softmax, matriz.pacientes.datos.centscal[-conjuntoEntrenamiento, 1:24], type="raw" )
pacientes.prediccion.test.1neu.softmax## 1 2 3 4
## 4 0.3079712 0.04816545 2.180539e-01 0.4258095
## 6 0.3079712 0.04816545 2.180539e-01 0.4258095
## 11 0.1175613 0.88243867 8.957335e-22 0.0000000
## 19 0.1175613 0.88243867 8.957335e-22 0.0000000
## 28 0.3079712 0.04816545 2.180539e-01 0.4258095
## 33 0.1175613 0.88243867 8.957335e-22 0.0000000
## 38 0.3079712 0.04816545 2.180539e-01 0.4258095
## 39 0.1175613 0.88243867 8.957335e-22 0.0000000
## 50 0.1175613 0.88243867 8.957335e-22 0.0000000
## 55 0.3079712 0.04816545 2.180539e-01 0.4258095
## 56 0.3079712 0.04816545 2.180539e-01 0.4258095
## 63 0.1175613 0.88243867 8.957335e-22 0.0000000pacientes.prediccion.test.1neu.class.softmax <- apply( pacientes.prediccion.test.1neu.softmax, MARGIN=1, FUN='which.is.max')
pacientes.prediccion.test.1neu.class.softmax## 4 6 11 19 28 33 38 39 50 55 56 63
## 4 4 2 2 4 2 4 2 2 4 4 2table( pacientes.prediccion.test.1neu.class.softmax , matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] )##
## pacientes.prediccion.test.1neu.class.softmax 1 2 3 4
## 2 0 5 1 0
## 4 2 0 1 3sum( diag( table( pacientes.prediccion.test.1neu.class.softmax, matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] ) ) )/12## [1] 02 NEURONAS
A partir de ahora voy a hacer exactamente lo mismo, por lo que haré chunks más grandes para evitar una sobrecarga de chunks, y reduciré la cantidad de comentarios, ya que serán redundantes
SIN SOFTMAX
pacientes.2neu <- nnet( matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], class.ind( matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) , size=2 )## # weights: 62
## initial value 53.635223
## iter 10 value 37.052176
## iter 20 value 35.307412
## iter 30 value 34.253417
## iter 40 value 34.000975
## iter 50 value 33.953518
## iter 60 value 33.911837
## iter 70 value 33.272020
## iter 80 value 33.111345
## iter 90 value 33.103489
## iter 100 value 33.101012
## final value 33.101012
## stopped after 100 iterationspacientes.prediccion.2neu <- predict( pacientes.2neu, matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], type="raw" )
head(pacientes.prediccion.2neu) # Vemos las probabilidades de pertenencia de cada valor## 1 2 3 4
## 24 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00
## 10 1.791563e-04 1.000000e+00 2.136112e-04 1.063625e-04
## 59 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00
## 23 3.563421e-06 2.621022e-03 3.357650e-06 6.100419e-07
## 54 0.000000e+00 8.007433e-07 5.198891e-07 0.000000e+00
## 30 5.416211e-07 8.005101e-01 3.419887e-06 5.355398e-07pacientes.prediccion.2neu.class <- apply( pacientes.prediccion.2neu, MARGIN=1, FUN='which.is.max')
pacientes.prediccion.2neu.class## 24 10 59 23 54 30 16 26 3 66 41 40 51 2 22 35 37 34 21 57 47 5 20 14 67 42 7 36 32 52 43 12 46
## 3 2 1 2 2 2 4 2 2 2 2 1 2 2 2 2 2 2 2 2 4 2 2 1 2 2 2 2 2 4 2 2 2
## 48 31 53 45 9 18 60 62 64 65 44 15 58 1 49 61 27 13 29 8 17 25
## 2 2 2 2 2 2 2 2 2 4 2 2 1 2 2 2 2 2 2 2 2 2table( pacientes.prediccion.2neu.class, matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) # Lo vemos en forma de tabla.##
## pacientes.prediccion.2neu.class 1 2 3 4
## 1 3 0 0 1
## 2 11 25 6 4
## 3 0 0 0 1
## 4 1 0 0 3sum( diag( table( pacientes.prediccion.2neu.class, matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) ) )/55 # Esta cuenta nos da el índice de acierto## [1] 0.5636364TEST
pacientes.prediccion.test.2neu <- predict( pacientes.2neu, matriz.pacientes.datos.centscal[-conjuntoEntrenamiento, 1:24], type="raw" )
pacientes.prediccion.test.2neu## 1 2 3 4
## 4 0.000000e+00 0.0000000 0.000000e+00 0.000000e+00
## 6 0.000000e+00 0.0000000 4.224729e-07 0.000000e+00
## 11 1.288315e-05 0.5029781 8.739386e-06 2.065532e-06
## 19 2.614462e-04 1.0000000 3.380128e-04 1.873200e-04
## 28 5.416211e-07 0.8005101 3.419887e-06 5.355398e-07
## 33 2.631931e-04 1.0000000 3.407782e-04 1.892110e-04
## 38 0.000000e+00 0.0000000 0.000000e+00 0.000000e+00
## 39 5.904531e-07 0.8567980 3.646701e-06 5.812322e-07
## 50 1.286812e-05 0.5000767 8.727010e-06 2.061926e-06
## 55 5.416211e-07 0.8005101 3.419887e-06 5.355398e-07
## 56 1.286812e-05 0.5000767 8.727010e-06 2.061926e-06
## 63 1.286817e-05 0.5000846 8.727044e-06 2.061936e-06pacientes.prediccion.test.2neu.class <- apply( pacientes.prediccion.test.2neu, MARGIN=1, FUN='which.is.max')
pacientes.prediccion.test.2neu.class## 4 6 11 19 28 33 38 39 50 55 56 63
## 3 3 2 2 2 2 2 2 2 2 2 2table( pacientes.prediccion.test.2neu.class , matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] )##
## pacientes.prediccion.test.2neu.class 1 2 3 4
## 2 2 5 2 1
## 3 0 0 0 2sum( diag( table( pacientes.prediccion.test.2neu.class, matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] ) ) )/12## [1] 0.1666667CON SOFTMAX
pacientes.2neu.softmax <- nnet( matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], class.ind( matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) , size=2, softmax = T )## # weights: 62
## initial value 80.943862
## iter 10 value 48.506726
## iter 20 value 43.319848
## iter 30 value 40.322310
## iter 40 value 39.615562
## iter 50 value 39.339418
## iter 60 value 39.285636
## iter 70 value 39.276453
## iter 80 value 39.274045
## iter 90 value 39.272883
## iter 100 value 39.272043
## final value 39.272043
## stopped after 100 iterationspacientes.prediccion.test.2neu.softmax <- predict( pacientes.2neu.softmax, matriz.pacientes.datos.centscal[-conjuntoEntrenamiento, 1:24], type="raw" )
head(pacientes.prediccion.test.2neu.softmax)## 1 2 3 4
## 4 0.11343465 0.07161132 0.2645941 0.5503599
## 6 0.05482695 0.74508254 0.2000905 0.0000000
## 11 0.15322701 0.84677299 0.0000000 0.0000000
## 19 0.05482695 0.74508254 0.2000905 0.0000000
## 28 0.15322701 0.84677299 0.0000000 0.0000000
## 33 0.15322701 0.84677299 0.0000000 0.0000000pacientes.prediccion.test.2neu.class.softmax <- apply( pacientes.prediccion.test.2neu.softmax, MARGIN=1, FUN='which.is.max')
pacientes.prediccion.test.2neu.class.softmax## 4 6 11 19 28 33 38 39 50 55 56 63
## 4 2 2 2 2 2 4 2 4 4 1 2table( pacientes.prediccion.test.2neu.class.softmax , matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] )##
## pacientes.prediccion.test.2neu.class.softmax 1 2 3 4
## 1 1 0 0 0
## 2 0 4 1 2
## 4 1 1 1 1sum( diag( table( pacientes.prediccion.test.2neu.class.softmax, matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] ) ) )/12## [1] 0.5TEST
pacientes.prediccion.test.2neu.softmax <- predict( pacientes.2neu.softmax, matriz.pacientes.datos.centscal[-conjuntoEntrenamiento, 1:24], type="raw" )
pacientes.prediccion.test.2neu.softmax## 1 2 3 4
## 4 0.11343465 0.07161132 0.2645941 0.5503599
## 6 0.05482695 0.74508254 0.2000905 0.0000000
## 11 0.15322701 0.84677299 0.0000000 0.0000000
## 19 0.05482695 0.74508254 0.2000905 0.0000000
## 28 0.15322701 0.84677299 0.0000000 0.0000000
## 33 0.15322701 0.84677299 0.0000000 0.0000000
## 38 0.11343465 0.07161132 0.2645941 0.5503599
## 39 0.15322701 0.84677299 0.0000000 0.0000000
## 50 0.11343465 0.07161132 0.2645941 0.5503599
## 55 0.11343465 0.07161132 0.2645941 0.5503599
## 56 0.66308906 0.17022729 0.0000000 0.1666836
## 63 0.15322701 0.84677299 0.0000000 0.0000000pacientes.prediccion.test.2neu.class.softmax <- apply( pacientes.prediccion.test.2neu.softmax, MARGIN=1, FUN='which.is.max')
pacientes.prediccion.test.2neu.class.softmax## 4 6 11 19 28 33 38 39 50 55 56 63
## 4 2 2 2 2 2 4 2 4 4 1 2table( pacientes.prediccion.test.2neu.class.softmax , matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] )##
## pacientes.prediccion.test.2neu.class.softmax 1 2 3 4
## 1 1 0 0 0
## 2 0 4 1 2
## 4 1 1 1 1sum(diag(table(pacientes.prediccion.test.2neu.class.softmax, matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] ) ) )/12## [1] 0.53 NEURONAS
SIN SOFTMAX
pacientes.3neu <- nnet( matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], class.ind( matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) , size=3)## # weights: 91
## initial value 54.473171
## iter 10 value 33.375019
## iter 20 value 26.008007
## iter 30 value 24.813062
## iter 40 value 23.656554
## iter 50 value 23.495156
## iter 60 value 23.386394
## iter 70 value 23.294149
## iter 80 value 23.256290
## iter 90 value 23.247647
## iter 100 value 23.245270
## final value 23.245270
## stopped after 100 iterationspacientes.prediccion.3neu <- predict( pacientes.3neu, matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], type="raw" )
head(pacientes.prediccion.3neu) # Vemos las probabilidades de pertenencia de cada valor## 1 2 3 4
## 24 0.1659772 0.09796803 0 0
## 10 0.0000000 1.00000000 0 0
## 59 0.1659772 0.09796803 0 0
## 23 0.3251707 0.61276531 0 0
## 54 0.0000000 0.27498192 0 0
## 30 0.0000000 0.84676734 0 0pacientes.prediccion.3neu.class <- apply( pacientes.prediccion.3neu, MARGIN=1, FUN='which.is.max')
pacientes.prediccion.3neu.class## 24 10 59 23 54 30 16 26 3 66 41 40 51 2 22 35 37 34 21 57 47 5 20 14 67 42 7 36 32 52 43 12 46
## 1 2 1 2 2 2 2 2 2 2 1 1 1 2 1 2 2 2 2 2 3 2 2 1 1 1 2 2 3 1 1 1 2
## 48 31 53 45 9 18 60 62 64 65 44 15 58 1 49 61 27 13 29 8 17 25
## 2 2 2 2 2 2 2 2 2 1 2 1 1 1 1 1 1 2 2 2 2 1table( pacientes.prediccion.3neu.class, matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) # Lo vemos en forma de tabla.##
## pacientes.prediccion.3neu.class 1 2 3 4
## 1 12 1 2 5
## 2 3 24 3 3
## 3 0 0 1 1sum( diag( table( pacientes.prediccion.3neu.class, matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) ) )/55 # Esta cuenta nos da el índice de acierto## [1] 0.6727273TEST
pacientes.prediccion.test.3neu <- predict( pacientes.3neu, matriz.pacientes.datos.centscal[-conjuntoEntrenamiento, 1:24], type="raw" )
pacientes.prediccion.test.3neu## 1 2 3 4
## 4 0.1659772 0.09796803 0 0
## 6 0.0000000 0.00000000 0 0
## 11 0.0000000 0.84676734 0 0
## 19 0.0000000 0.84676734 0 0
## 28 0.0000000 0.27498192 0 0
## 33 0.0000000 0.84676734 0 0
## 38 0.1659772 0.09796803 0 0
## 39 0.0000000 0.84676734 0 0
## 50 0.0000000 0.00000000 0 0
## 55 0.0000000 0.27498192 0 0
## 56 1.0000000 0.00000000 0 0
## 63 0.3251707 0.61276531 0 0pacientes.prediccion.test.3neu.class <- apply( pacientes.prediccion.test.3neu, MARGIN=1, FUN='which.is.max')
pacientes.prediccion.test.3neu.class## 4 6 11 19 28 33 38 39 50 55 56 63
## 1 1 2 2 2 2 1 2 2 2 1 2table( pacientes.prediccion.test.3neu.class , matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] )##
## pacientes.prediccion.test.3neu.class 1 2 3 4
## 1 1 0 1 2
## 2 1 5 1 1sum( diag( table( pacientes.prediccion.test.3neu.class, matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] ) ) )/12## [1] 0.5CON SOFTMAX
pacientes.3neu.softmax <- nnet( matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], class.ind( matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) , size=3, softmax = T)## # weights: 91
## initial value 87.663400
## iter 10 value 42.674894
## iter 20 value 34.514508
## iter 30 value 33.204708
## iter 40 value 32.547169
## iter 50 value 32.389704
## iter 60 value 32.369878
## iter 70 value 32.366864
## iter 80 value 32.365889
## iter 90 value 32.365393
## iter 100 value 32.365006
## final value 32.365006
## stopped after 100 iterationspacientes.prediccion.3neu.softmax <- predict( pacientes.3neu.softmax, matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], type="raw" )
head(pacientes.prediccion.3neu.softmax) # Vemos las probabilidades de pertenencia de cada valor## 1 2 3 4
## 24 0.2023960 0.01573543 0.22220075 0.5596678
## 10 0.0000000 0.42821184 0.32179714 0.2499910
## 59 0.2023960 0.01573543 0.22220075 0.5596678
## 23 0.4483735 0.55162651 0.00000000 0.0000000
## 54 0.2023960 0.01573543 0.22220075 0.5596678
## 30 0.0000000 0.95269588 0.04730412 0.0000000pacientes.prediccion.3neu.class.softmax <- apply(pacientes.prediccion.3neu.softmax, MARGIN=1, FUN='which.is.max')
pacientes.prediccion.3neu.class.softmax## 24 10 59 23 54 30 16 26 3 66 41 40 51 2 22 35 37 34 21 57 47 5 20 14 67 42 7 36 32 52 43 12 46
## 4 2 4 2 4 2 4 2 2 2 2 2 1 2 4 2 2 2 2 2 4 2 2 4 1 1 4 2 4 1 1 1 2
## 48 31 53 45 9 18 60 62 64 65 44 15 58 1 49 61 27 13 29 8 17 25
## 2 2 2 2 2 2 2 2 2 4 2 4 1 3 1 1 4 2 2 2 2 2table( pacientes.prediccion.3neu.class.softmax, matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) # Lo vemos en forma de tabla.##
## pacientes.prediccion.3neu.class.softmax 1 2 3 4
## 1 7 1 0 1
## 2 5 24 3 1
## 3 1 0 0 0
## 4 2 0 3 7sum( diag( table( pacientes.prediccion.3neu.class.softmax, matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) ) )/55 # Esta cuenta nos da el índice de acierto## [1] 0.6909091TEST
pacientes.prediccion.test.3neu.softmax <- predict( pacientes.3neu.softmax, matriz.pacientes.datos.centscal[-conjuntoEntrenamiento, 1:24], type="raw" )
pacientes.prediccion.test.3neu.softmax## 1 2 3 4
## 4 0.2023960 0.01573543 0.22220075 0.5596678
## 6 0.0000000 0.42821184 0.32179714 0.2499910
## 11 0.2581955 0.38375535 0.35804913 0.0000000
## 19 0.2581955 0.38375535 0.35804913 0.0000000
## 28 0.0000000 1.00000000 0.00000000 0.0000000
## 33 0.0000000 1.00000000 0.00000000 0.0000000
## 38 0.2023960 0.01573543 0.22220075 0.5596678
## 39 0.0000000 1.00000000 0.00000000 0.0000000
## 50 0.0000000 0.95269588 0.04730412 0.0000000
## 55 0.0000000 0.42821184 0.32179714 0.2499910
## 56 0.0000000 0.42821184 0.32179714 0.2499910
## 63 0.0000000 1.00000000 0.00000000 0.0000000pacientes.prediccion.test.3neu.class.softmax <- apply( pacientes.prediccion.test.3neu.softmax, MARGIN=1, FUN='which.is.max')
pacientes.prediccion.test.3neu.class.softmax## 4 6 11 19 28 33 38 39 50 55 56 63
## 4 2 2 2 2 2 4 2 2 2 2 2table( pacientes.prediccion.test.3neu.class.softmax , matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] )##
## pacientes.prediccion.test.3neu.class.softmax 1 2 3 4
## 2 2 5 1 2
## 4 0 0 1 1sum( diag( table( pacientes.prediccion.test.3neu.class.softmax, matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] ) ) )/12## [1] 0.16666673 NEURONAS
Con Decay
SIN SOFTMAX
pacientes.3neu.decay <- nnet( matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], class.ind( matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) , size=3, decay = 0.2)## # weights: 91
## initial value 73.960838
## iter 10 value 33.105128
## iter 20 value 31.867159
## iter 30 value 31.747295
## iter 40 value 31.692715
## iter 50 value 31.683949
## iter 60 value 31.682322
## final value 31.682293
## convergedpacientes.prediccion.3neu.decay <- predict( pacientes.3neu.decay, matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], type="raw" )
head(pacientes.prediccion.3neu.decay) # Vemos las probabilidades de pertenencia de cada valor## 1 2 3 4
## 24 0.48737600 0.1314007 0.1184422 0.4075685
## 10 0.07926587 0.6084056 0.1404220 0.2956201
## 59 0.32995195 0.1581183 0.1279921 0.4828975
## 23 0.64034724 0.2036311 0.1330932 0.2043844
## 54 0.34120075 0.3768366 0.2116181 0.2402483
## 30 0.11082354 0.7793591 0.1347161 0.1185832pacientes.prediccion.3neu.class.decay <- apply( pacientes.prediccion.3neu.decay, MARGIN=1, FUN='which.is.max')
pacientes.prediccion.3neu.class.decay## 24 10 59 23 54 30 16 26 3 66 41 40 51 2 22 35 37 34 21 57 47 5 20 14 67 42 7 36 32 52 43 12 46
## 1 2 4 1 2 2 4 2 2 2 2 1 1 2 2 2 2 2 2 2 4 2 2 1 1 1 4 2 2 1 1 1 4
## 48 31 53 45 9 18 60 62 64 65 44 15 58 1 49 61 27 13 29 8 17 25
## 2 2 2 2 2 1 2 2 2 4 2 2 1 1 1 1 4 2 2 2 2 1table( pacientes.prediccion.3neu.class.decay, matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) # Lo vemos en forma de tabla.##
## pacientes.prediccion.3neu.class.decay 1 2 3 4
## 1 12 2 0 2
## 2 3 22 6 1
## 4 0 1 0 6sum( diag( table( pacientes.prediccion.3neu.class.decay, matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) ) )/55 # Esta cuenta nos da el índice de acierto## [1] 0.6181818TEST
pacientes.prediccion.test.3neu.decay <- predict( pacientes.3neu.decay, matriz.pacientes.datos.centscal[-conjuntoEntrenamiento, 1:24], type="raw" )
pacientes.prediccion.test.3neu.decay## 1 2 3 4
## 4 0.3402639 0.1834900 0.14637019 0.43828299
## 6 0.1733815 0.3933274 0.08568651 0.31053705
## 11 0.1836559 0.3358063 0.11053965 0.37178349
## 19 0.1050653 0.5851981 0.15835848 0.27461518
## 28 0.2230893 0.5418946 0.07358426 0.15487234
## 33 0.1588428 0.8204895 0.13849206 0.07039891
## 38 0.5730220 0.1351184 0.13218901 0.34537496
## 39 0.1985316 0.8087534 0.14580024 0.06333927
## 50 0.3676564 0.3277778 0.19814004 0.26103526
## 55 0.1848146 0.4105823 0.07877368 0.27803842
## 56 0.3043091 0.1807988 0.14705154 0.47455894
## 63 0.1673797 0.7593566 0.16641200 0.10031902pacientes.prediccion.test.3neu.class.decay <- apply( pacientes.prediccion.test.3neu.decay, MARGIN=1, FUN='which.is.max')
pacientes.prediccion.test.3neu.class.decay## 4 6 11 19 28 33 38 39 50 55 56 63
## 4 2 4 2 2 2 1 2 1 2 4 2table( pacientes.prediccion.test.3neu.class.decay , matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] )##
## pacientes.prediccion.test.3neu.class.decay 1 2 3 4
## 1 0 1 1 0
## 2 1 3 1 2
## 4 1 1 0 1sum( diag( table( pacientes.prediccion.test.3neu.class.decay, matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] ) ) )/12## [1] 0.25CON SOFTMAX
pacientes.3neu.decay.softmax <- nnet( matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], class.ind( matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) , size=3, softmax = T, decay = 0.03)## # weights: 91
## initial value 85.498699
## iter 10 value 47.852636
## iter 20 value 39.739770
## iter 30 value 35.806208
## iter 40 value 32.170939
## iter 50 value 27.297151
## iter 60 value 26.478375
## iter 70 value 26.125129
## iter 80 value 26.027660
## iter 90 value 26.013133
## iter 100 value 26.011396
## final value 26.011396
## stopped after 100 iterationspacientes.prediccion.3neu.decay.softmax <- predict( pacientes.3neu.decay.softmax, matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], type="raw" )
head(pacientes.prediccion.3neu.decay.softmax) # Vemos las probabilidades de pertenencia de cada valor## 1 2 3 4
## 24 0.1182238067 0.129916764 0.0194208591 7.324386e-01
## 10 0.0001444921 0.893313593 0.0748799357 3.166198e-02
## 59 0.1243653762 0.108423196 0.0257790455 7.414324e-01
## 23 0.9958311280 0.003930236 0.0001629312 7.570468e-05
## 54 0.0033167040 0.078981480 0.9134641326 4.237683e-03
## 30 0.0597875442 0.927432364 0.0125360896 2.440019e-04pacientes.prediccion.3neu.class.decay.softmax <- apply( pacientes.prediccion.3neu.decay.softmax, MARGIN=1, FUN='which.is.max')
pacientes.prediccion.3neu.class.decay.softmax## 24 10 59 23 54 30 16 26 3 66 41 40 51 2 22 35 37 34 21 57 47 5 20 14 67 42 7 36 32 52 43 12 46
## 4 2 4 1 3 2 4 3 2 2 3 1 4 2 1 2 2 2 2 3 4 2 2 1 1 1 4 2 3 1 1 1 1
## 48 31 53 45 9 18 60 62 64 65 44 15 58 1 49 61 27 13 29 8 17 25
## 2 2 2 2 2 1 2 1 2 4 2 1 1 1 4 4 4 2 2 2 4 1table( pacientes.prediccion.3neu.class.decay.softmax, matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) # Lo vemos en forma de tabla.##
## pacientes.prediccion.3neu.class.decay.softmax 1 2 3 4
## 1 13 2 1 0
## 2 1 22 0 0
## 3 0 0 5 0
## 4 1 1 0 9sum( diag( table( pacientes.prediccion.3neu.class.decay.softmax, matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) ) )/55 # Esta cuenta nos da el índice de acierto## [1] 0.8909091TEST
pacientes.prediccion.test.3neu.decay.softmax <- predict( pacientes.3neu.decay.softmax, matriz.pacientes.datos.centscal[-conjuntoEntrenamiento, 1:24], type="raw" )
pacientes.prediccion.test.3neu.decay.softmax## 1 2 3 4
## 4 0.0716494640 0.127055344 0.0161805500 7.851146e-01
## 6 0.0029654753 0.555104711 0.3847807070 5.714911e-02
## 11 0.0742577241 0.132255868 0.0157539429 7.777325e-01
## 19 0.0005545471 0.852469717 0.0713324820 7.564325e-02
## 28 0.0002543558 0.983890983 0.0091797823 6.674879e-03
## 33 0.0003225122 0.999483263 0.0001173039 7.692048e-05
## 38 0.9089542462 0.001228223 0.0650459283 2.477160e-02
## 39 0.0003799218 0.999412681 0.0001224026 8.499460e-05
## 50 0.3281182206 0.021631003 0.6208395652 2.941121e-02
## 55 0.0028681944 0.038215167 0.9562159639 2.700675e-03
## 56 0.0969738512 0.115908339 0.0204111396 7.667067e-01
## 63 0.0013461698 0.998112314 0.0004138980 1.276187e-04pacientes.prediccion.test.3neu.class.decay.softmax <- apply( pacientes.prediccion.test.3neu.decay.softmax, MARGIN=1, FUN='which.is.max')
pacientes.prediccion.test.3neu.class.decay.softmax## 4 6 11 19 28 33 38 39 50 55 56 63
## 4 2 4 2 2 2 1 2 3 3 4 2table( pacientes.prediccion.test.3neu.class.decay.softmax , matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] )##
## pacientes.prediccion.test.3neu.class.decay.softmax 1 2 3 4
## 1 0 0 1 0
## 2 0 3 1 2
## 3 1 1 0 0
## 4 1 1 0 1sum( diag( table( pacientes.prediccion.test.3neu.class.decay.softmax, matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] ) ) )/12## [1] 0.33333335 NEURONAS
SIN SOFTMAX
pacientes.5neu <- nnet( matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], class.ind( matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) , size=5 )## # weights: 149
## initial value 64.573378
## iter 10 value 33.389349
## iter 20 value 31.593887
## iter 30 value 31.017595
## iter 40 value 31.000008
## final value 30.999999
## convergedpacientes.prediccion.5neu <- predict( pacientes.5neu, matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], type="raw" )
head(pacientes.prediccion.5neu) # Vemos las probabilidades de pertenencia de cada valor## 1 2 3 4
## 24 0 0 0 0
## 10 0 1 0 0
## 59 0 0 0 0
## 23 0 0 0 0
## 54 0 0 0 0
## 30 0 1 0 0pacientes.prediccion.5neu.class <- apply( pacientes.prediccion.5neu, MARGIN=1, FUN='which.is.max')
pacientes.prediccion.5neu.class## 24 10 59 23 54 30 16 26 3 66 41 40 51 2 22 35 37 34 21 57 47 5 20 14 67 42 7 36 32 52 43 12 46
## 4 2 2 2 4 2 4 4 2 2 4 2 3 2 2 2 2 2 2 4 1 2 2 2 1 3 1 2 3 1 4 4 2
## 48 31 53 45 9 18 60 62 64 65 44 15 58 1 49 61 27 13 29 8 17 25
## 2 2 2 2 2 2 2 3 2 3 2 4 3 1 2 1 4 2 2 2 2 1table( pacientes.prediccion.5neu.class, matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) # Lo vemos en forma de tabla.##
## pacientes.prediccion.5neu.class 1 2 3 4
## 1 4 1 0 2
## 2 5 24 1 2
## 3 3 0 1 2
## 4 3 0 4 3sum( diag( table( pacientes.prediccion.5neu.class, matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) ) )/55 # Esta cuenta nos da el índice de acierto## [1] 0.5818182TEST
pacientes.prediccion.test.5neu <- predict( pacientes.5neu, matriz.pacientes.datos.centscal[-conjuntoEntrenamiento, 1:24], type="raw" )
pacientes.prediccion.test.5neu## 1 2 3 4
## 4 0.000000e+00 0.00126513 0.000000e+00 0.000000e+00
## 6 0.000000e+00 0.00000000 0.000000e+00 0.000000e+00
## 11 0.000000e+00 1.00000000 0.000000e+00 0.000000e+00
## 19 5.990733e-05 0.00000000 7.657195e-06 7.578264e-07
## 28 0.000000e+00 0.01535590 0.000000e+00 0.000000e+00
## 33 0.000000e+00 1.00000000 0.000000e+00 0.000000e+00
## 38 0.000000e+00 0.00000000 0.000000e+00 0.000000e+00
## 39 3.424426e-07 1.00000000 0.000000e+00 0.000000e+00
## 50 7.031794e-07 0.00000000 0.000000e+00 0.000000e+00
## 55 0.000000e+00 0.00000000 0.000000e+00 0.000000e+00
## 56 0.000000e+00 0.00000000 0.000000e+00 0.000000e+00
## 63 3.967965e-05 0.00000000 4.625426e-06 4.132421e-07pacientes.prediccion.test.5neu.class <- apply( pacientes.prediccion.test.5neu, MARGIN=1, FUN='which.is.max')
pacientes.prediccion.test.5neu.class## 4 6 11 19 28 33 38 39 50 55 56 63
## 2 3 2 1 2 2 2 2 1 4 4 1table( pacientes.prediccion.test.5neu.class , matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] )##
## pacientes.prediccion.test.5neu.class 1 2 3 4
## 1 0 2 1 0
## 2 0 3 1 2
## 3 0 0 0 1
## 4 2 0 0 0sum( diag( table( pacientes.prediccion.test.5neu.class, matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] ) ) )/12## [1] 0.25CON SOFTMAX
pacientes.5neu.softmax <- nnet( matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], class.ind( matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) , size=5, softmax = T )## # weights: 149
## initial value 79.759417
## iter 10 value 31.044081
## iter 20 value 11.019156
## iter 30 value 8.335342
## iter 40 value 8.285752
## iter 50 value 8.275640
## iter 60 value 8.254880
## iter 70 value 8.239334
## iter 80 value 8.215216
## iter 90 value 8.209928
## iter 100 value 8.187330
## final value 8.187330
## stopped after 100 iterationspacientes.prediccion.5neu.softmax <- predict( pacientes.5neu.softmax, matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], type="raw" )
head(pacientes.prediccion.5neu.softmax) # Vemos las probabilidades de pertenencia de cada valor## 1 2 3 4
## 24 3.219861e-84 6.978022e-28 1.411023e-92 1.000000e+00
## 10 1.835214e-193 1.000000e+00 1.465255e-80 1.413365e-75
## 59 1.142914e-164 2.827379e-199 2.371895e-222 1.000000e+00
## 23 1.000000e+00 2.957844e-157 8.191937e-59 5.228649e-91
## 54 6.700142e-64 4.982844e-84 1.000000e+00 8.687166e-120
## 30 1.154948e-46 1.000000e+00 7.715277e-32 2.529519e-157pacientes.prediccion.5neu.class.softmax <- apply( pacientes.prediccion.5neu.softmax, MARGIN=1, FUN='which.is.max')
pacientes.prediccion.5neu.class.softmax## 24 10 59 23 54 30 16 26 3 66 41 40 51 2 22 35 37 34 21 57 47 5 20 14 67 42 7 36 32 52 43 12 46
## 4 2 4 1 3 2 4 3 2 2 3 1 1 2 1 2 2 2 2 3 4 2 2 1 1 1 4 2 2 1 1 1 4
## 48 31 53 45 9 18 60 62 64 65 44 15 58 1 49 61 27 13 29 8 17 25
## 2 2 2 2 2 2 2 1 2 4 2 1 1 1 1 2 4 2 2 2 4 1table( pacientes.prediccion.5neu.class.softmax, matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) # Lo vemos en forma de tabla.##
## pacientes.prediccion.5neu.class.softmax 1 2 3 4
## 1 14 0 1 1
## 2 1 24 1 0
## 3 0 0 4 0
## 4 0 1 0 8sum( diag( table( pacientes.prediccion.5neu.class.softmax, matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) ) )/55 # Esta cuenta nos da el índice de acierto## [1] 0.9090909TEST
pacientes.prediccion.test.5neu.softmax <- predict( pacientes.5neu.softmax, matriz.pacientes.datos.centscal[-conjuntoEntrenamiento, 1:24], type="raw" )
pacientes.prediccion.test.5neu.softmax## 1 2 3 4
## 4 1.142914e-164 2.827379e-199 2.371895e-222 1.000000e+00
## 6 4.609023e-199 2.866800e-97 1.742690e-135 1.000000e+00
## 11 3.219861e-84 6.978022e-28 1.411023e-92 1.000000e+00
## 19 3.529493e-84 7.237981e-28 1.592867e-92 1.000000e+00
## 28 1.712843e-35 2.634878e-01 3.122707e-01 4.242415e-01
## 33 1.318371e-137 1.000000e+00 1.859696e-73 0.000000e+00
## 38 1.000000e+00 5.359811e-12 2.112999e-38 3.545416e-81
## 39 1.318371e-137 1.000000e+00 1.859696e-73 0.000000e+00
## 50 1.000000e+00 5.359811e-12 2.112999e-38 3.545416e-81
## 55 8.804613e-109 2.647581e-61 2.725361e-16 1.000000e+00
## 56 1.712843e-35 2.634878e-01 3.122707e-01 4.242415e-01
## 63 3.172991e-113 2.067221e-42 1.000000e+00 1.460291e-249pacientes.prediccion.test.5neu.class.softmax <- apply( pacientes.prediccion.test.5neu.softmax, MARGIN=1, FUN='which.is.max')
pacientes.prediccion.test.5neu.class.softmax## 4 6 11 19 28 33 38 39 50 55 56 63
## 4 4 4 4 4 2 1 2 1 4 4 3table( pacientes.prediccion.test.5neu.class.softmax, matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] )##
## pacientes.prediccion.test.5neu.class.softmax 1 2 3 4
## 1 0 1 1 0
## 2 0 2 0 0
## 3 0 0 1 0
## 4 2 2 0 3sum( diag( table( pacientes.prediccion.test.5neu.class.softmax, matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] ) ) )/12## [1] 0.55 NEURONAS
CON DECAY
SIN SOFTMAX
pacientes.5neu.decay <- nnet( matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], class.ind( matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) , size=5, decay=0.1)## # weights: 149
## initial value 63.077445
## iter 10 value 32.430559
## iter 20 value 25.943179
## iter 30 value 25.327436
## iter 40 value 24.947927
## iter 50 value 24.889991
## iter 60 value 24.887628
## iter 70 value 24.887518
## final value 24.887516
## convergedpacientes.prediccion.5neu.decay <- predict( pacientes.5neu.decay, matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], type="raw" )
head(pacientes.prediccion.5neu.decay) # Vemos las probabilidades de pertenencia de cada valor## 1 2 3 4
## 24 0.43320317 0.06206106 0.07700167 0.59027518
## 10 0.01590787 0.69195444 0.22996899 0.31334595
## 59 0.21061167 0.08920053 0.11604952 0.71710081
## 23 0.84457611 0.10037978 0.09042151 0.05090945
## 54 0.25340641 0.31151357 0.58502982 0.05301050
## 30 0.05697958 0.88742835 0.13978315 0.04603405pacientes.prediccion.5neu.decay.class <- apply( pacientes.prediccion.5neu.decay, MARGIN=1, FUN='which.is.max')
pacientes.prediccion.5neu.decay.class## 24 10 59 23 54 30 16 26 3 66 41 40 51 2 22 35 37 34 21 57 47 5 20 14 67 42 7 36 32 52 43 12 46
## 4 2 4 1 3 2 4 2 2 2 3 1 1 2 3 2 2 2 2 3 4 2 2 1 1 1 4 2 4 1 1 1 2
## 48 31 53 45 9 18 60 62 64 65 44 15 58 1 49 61 27 13 29 8 17 25
## 2 2 2 2 2 2 2 2 2 4 2 3 1 1 1 1 4 2 2 2 4 1table( pacientes.prediccion.5neu.decay.class, matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) # Lo vemos en forma de tabla.##
## pacientes.prediccion.5neu.decay.class 1 2 3 4
## 1 12 1 0 1
## 2 2 24 1 0
## 3 1 0 4 0
## 4 0 0 1 8sum( diag( table( pacientes.prediccion.5neu.decay.class, matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) ) )/55 # Esta cuenta nos da el índice de acierto## [1] 0.8727273TEST
pacientes.prediccion.test.decay.5neu <- predict( pacientes.5neu.decay, matriz.pacientes.datos.centscal[-conjuntoEntrenamiento, 1:24], type="raw" )
pacientes.prediccion.test.decay.5neu## 1 2 3 4
## 4 0.26237039 0.14220583 0.08408299 0.64694316
## 6 0.11090530 0.41068737 0.02069368 0.37895350
## 11 0.14999606 0.24198683 0.03632280 0.63501839
## 19 0.04563775 0.49217649 0.34514321 0.16371540
## 28 0.15324537 0.61029243 0.04440344 0.12493438
## 33 0.07790208 0.95450284 0.07226146 0.02037313
## 38 0.69693225 0.01451246 0.29330054 0.38263025
## 39 0.16335234 0.87422849 0.16609554 0.01143432
## 50 0.46053345 0.14860055 0.28430741 0.13893366
## 55 0.13730085 0.11311572 0.29288552 0.17985648
## 56 0.35838385 0.06469235 0.10391050 0.45854138
## 63 0.19308781 0.72901760 0.24644606 0.01642865pacientes.prediccion.test.decay.5neu.class <- apply( pacientes.prediccion.test.decay.5neu, MARGIN=1, FUN='which.is.max')
pacientes.prediccion.test.decay.5neu.class## 4 6 11 19 28 33 38 39 50 55 56 63
## 4 2 4 2 2 2 1 2 1 3 4 2table( pacientes.prediccion.test.decay.5neu.class , matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] )##
## pacientes.prediccion.test.decay.5neu.class 1 2 3 4
## 1 0 1 1 0
## 2 0 3 1 2
## 3 1 0 0 0
## 4 1 1 0 1sum( diag( table( pacientes.prediccion.test.decay.5neu.class, matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] ) ) )/12## [1] 0.3333333CON SOFTMAX
pacientes.5neu.decay.softmax <- nnet( matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], class.ind( matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) , size=5, softmax = T, decay = 0.05)## # weights: 149
## initial value 78.111583
## iter 10 value 39.866112
## iter 20 value 28.351528
## iter 30 value 24.307832
## iter 40 value 23.189410
## iter 50 value 22.957626
## iter 60 value 22.907393
## iter 70 value 22.532748
## iter 80 value 22.355728
## iter 90 value 22.334271
## iter 100 value 22.333841
## final value 22.333841
## stopped after 100 iterationspacientes.prediccion.5neu.decay.softmax <- predict( pacientes.5neu.decay.softmax, matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], type="raw" )
head(pacientes.prediccion.5neu.decay.softmax) # Vemos las probabilidades de pertenencia de cada valor## 1 2 3 4
## 24 0.149912698 0.00735000 0.007653743 0.8350835588
## 10 0.006421462 0.91898761 0.031156701 0.0434342269
## 59 0.033305049 0.01349691 0.007810394 0.9453876512
## 23 0.989196048 0.00660715 0.003936149 0.0002606529
## 54 0.045390923 0.00507830 0.936603432 0.0129273453
## 30 0.016011931 0.94320074 0.036922919 0.0038644112pacientes.prediccion.5neu.decay.class.softmax <- apply( pacientes.prediccion.5neu.decay.softmax, MARGIN=1, FUN='which.is.max')
pacientes.prediccion.5neu.decay.class.softmax## 24 10 59 23 54 30 16 26 3 66 41 40 51 2 22 35 37 34 21 57 47 5 20 14 67 42 7 36 32 52 43 12 46
## 4 2 4 1 3 2 4 3 2 2 3 1 1 2 1 2 2 2 2 3 4 2 2 1 1 1 4 2 3 1 1 1 2
## 48 31 53 45 9 18 60 62 64 65 44 15 58 1 49 61 27 13 29 8 17 25
## 2 2 2 2 2 2 2 1 2 4 2 1 1 1 1 2 4 2 2 2 4 1table( pacientes.prediccion.5neu.decay.class.softmax, matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) # Lo vemos en forma de tabla.##
## pacientes.prediccion.5neu.decay.class.softmax 1 2 3 4
## 1 14 0 1 1
## 2 1 25 0 0
## 3 0 0 5 0
## 4 0 0 0 8sum( diag( table( pacientes.prediccion.5neu.decay.class.softmax, matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) ) )/55 # Esta cuenta nos da el índice de acierto## [1] 0.9454545TEST
pacientes.prediccion.test.decay.5neu.softmax <- predict( pacientes.5neu.decay.softmax, matriz.pacientes.datos.centscal[-conjuntoEntrenamiento, 1:24], type="raw" )
pacientes.prediccion.test.decay.5neu.softmax## 1 2 3 4
## 4 0.148997576 0.026156990 0.0039253571 8.209201e-01
## 6 0.003332360 0.213932929 0.0240601149 7.586746e-01
## 11 0.020992484 0.180188067 0.0003783475 7.984411e-01
## 19 0.017788509 0.295566642 0.0010483337 6.855965e-01
## 28 0.082857716 0.876639865 0.0209849102 1.951751e-02
## 33 0.009325413 0.989131643 0.0009506652 5.922792e-04
## 38 0.186567183 0.001903112 0.6893687732 1.221609e-01
## 39 0.036305211 0.963494999 0.0001133434 8.644665e-05
## 50 0.780672072 0.014949741 0.0899116418 1.144665e-01
## 55 0.026899792 0.001521353 0.9631967367 8.382119e-03
## 56 0.633855654 0.017638904 0.0193431906 3.291623e-01
## 63 0.690231873 0.307335430 0.0007240871 1.708610e-03pacientes.prediccion.test.decay.5neu.class.softmax <- apply( pacientes.prediccion.test.decay.5neu.softmax, MARGIN=1, FUN='which.is.max')
pacientes.prediccion.test.decay.5neu.class.softmax## 4 6 11 19 28 33 38 39 50 55 56 63
## 4 4 4 4 2 2 3 2 1 3 1 1table( pacientes.prediccion.test.decay.5neu.class.softmax , matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] )##
## pacientes.prediccion.test.decay.5neu.class.softmax 1 2 3 4
## 1 1 1 1 0
## 2 0 2 0 1
## 3 1 0 1 0
## 4 0 2 0 2sum( diag( table( pacientes.prediccion.test.decay.5neu.class.softmax, matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] ) ) )/12## [1] 0.5Obtención de Resultados de Perceptrón
Importo los datos:
dataset.resultados <- read.csv2("C:/Users/jorge/Desktop/Documentos Clase/Universidad/4ºCarrera/1er Cuatrimestre/Inteligencia Artificial/Trabajo Fin de Asignatura/Resultados.txt")Ahora voy a sacar un gráfico interactivo donde comparo los resultados.
#install.packages("plotly")
library("plotly")##
## Attaching package: 'plotly'## The following object is masked from 'package:ggplot2':
##
## last_plot## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layouttipos = dataset.resultados[, 1]
real = dataset.resultados[, 2]
practico = dataset.resultados[, 3]
p<- plot_ly(dataset.resultados, x = ~tipos, y = ~real, type = 'bar', name = 'Real') %>% add_trace(y = ~practico, name = 'Práctico') %>% layout(yaxis = list(title = 'Porcentaje'), barmode = 'group')
p #Mostramos el gráfico interactivoAhora que hemos sacado los resultados obtenidos con el perceptrón multicapa, vamos con otras técnicas supervisadas:
KNN
Instalamos la librería class:
#install.packages("class")
library("class")## Warning: package 'class' was built under R version 3.5.2Hacemos nuevos conjuntos:
# Para hacer la predicción con knn, voy a coger los grupos de una manera distinta:
conjuntoEntrenamiento = matriz.pacientes.datos.centscal[1:55, 1:24]
conjuntoTest = matriz.pacientes.datos.centscal[56:67, 1:24]
# Utilizo por supuesto la matriz de centrado y escalado
etiquetasEntrenamiento = matriz.pacientes.etiquetas[1:55, 25]
etiquetasTest = matriz.pacientes.etiquetas[56:67, 25]Si quisiéramos mostrar los conjuntos de entrenamiento y de test…
conjuntoEntrenamiento
conjuntoTest
etiquetasEntrenamiento
etiquetasTestPara sacar los resultados de una manera visual, importamos lo siguiente:
#install.packages("gmodels")
library("gmodels")Comenzamos las pruebas. Como sabemos, normalmente el mejor valor de K para KNN suele ser el valor que más se acerque a la raíz cuadrada del total de los valores. Por eso, empezaremos por K = 8:
Para K = 8…
prediccion.knn.8 <- knn(train = conjuntoEntrenamiento, test = conjuntoTest, cl = etiquetasEntrenamiento, k = 8)
prediccion.knn.8## [1] 1 2 2 1 2 1 2 2 4 1 2 2
## Levels: 1 2 3 4Sacamos crosstable:
CrossTable(x = etiquetasTest , y = prediccion.knn.8, prop.chisq = FALSE)##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Row Total |
## | N / Col Total |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 12
##
##
## | prediccion.knn.8
## etiquetasTest | 1 | 2 | 4 | Row Total |
## --------------|-----------|-----------|-----------|-----------|
## 1 | 1 | 3 | 0 | 4 |
## | 0.250 | 0.750 | 0.000 | 0.333 |
## | 0.250 | 0.429 | 0.000 | |
## | 0.083 | 0.250 | 0.000 | |
## --------------|-----------|-----------|-----------|-----------|
## 2 | 1 | 2 | 1 | 4 |
## | 0.250 | 0.500 | 0.250 | 0.333 |
## | 0.250 | 0.286 | 1.000 | |
## | 0.083 | 0.167 | 0.083 | |
## --------------|-----------|-----------|-----------|-----------|
## 3 | 0 | 2 | 0 | 2 |
## | 0.000 | 1.000 | 0.000 | 0.167 |
## | 0.000 | 0.286 | 0.000 | |
## | 0.000 | 0.167 | 0.000 | |
## --------------|-----------|-----------|-----------|-----------|
## 4 | 2 | 0 | 0 | 2 |
## | 1.000 | 0.000 | 0.000 | 0.167 |
## | 0.500 | 0.000 | 0.000 | |
## | 0.167 | 0.000 | 0.000 | |
## --------------|-----------|-----------|-----------|-----------|
## Column Total | 4 | 7 | 1 | 12 |
## | 0.333 | 0.583 | 0.083 | |
## --------------|-----------|-----------|-----------|-----------|
##
## Para K = 6
prediccion.knn.6 <- knn(train = conjuntoEntrenamiento, test = conjuntoTest, cl = etiquetasEntrenamiento, k = 6)
prediccion.knn.6## [1] 4 2 2 1 2 1 2 2 2 1 2 2
## Levels: 1 2 3 4Obtenemos la crosstable:
CrossTable(x = etiquetasTest , y = prediccion.knn.6, prop.chisq = FALSE)##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Row Total |
## | N / Col Total |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 12
##
##
## | prediccion.knn.6
## etiquetasTest | 1 | 2 | 4 | Row Total |
## --------------|-----------|-----------|-----------|-----------|
## 1 | 0 | 3 | 1 | 4 |
## | 0.000 | 0.750 | 0.250 | 0.333 |
## | 0.000 | 0.375 | 1.000 | |
## | 0.000 | 0.250 | 0.083 | |
## --------------|-----------|-----------|-----------|-----------|
## 2 | 1 | 3 | 0 | 4 |
## | 0.250 | 0.750 | 0.000 | 0.333 |
## | 0.333 | 0.375 | 0.000 | |
## | 0.083 | 0.250 | 0.000 | |
## --------------|-----------|-----------|-----------|-----------|
## 3 | 0 | 2 | 0 | 2 |
## | 0.000 | 1.000 | 0.000 | 0.167 |
## | 0.000 | 0.250 | 0.000 | |
## | 0.000 | 0.167 | 0.000 | |
## --------------|-----------|-----------|-----------|-----------|
## 4 | 2 | 0 | 0 | 2 |
## | 1.000 | 0.000 | 0.000 | 0.167 |
## | 0.667 | 0.000 | 0.000 | |
## | 0.167 | 0.000 | 0.000 | |
## --------------|-----------|-----------|-----------|-----------|
## Column Total | 3 | 8 | 1 | 12 |
## | 0.250 | 0.667 | 0.083 | |
## --------------|-----------|-----------|-----------|-----------|
##
## Para k = 10
prediccion.knn.10 <- knn(train = conjuntoEntrenamiento, test = conjuntoTest, cl = etiquetasEntrenamiento, k = 10)
prediccion.knn.10## [1] 1 2 2 1 2 1 2 2 4 1 2 2
## Levels: 1 2 3 4Obtenemos la crosstable:
CrossTable(x = etiquetasTest , y = prediccion.knn.10, prop.chisq = FALSE)##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Row Total |
## | N / Col Total |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 12
##
##
## | prediccion.knn.10
## etiquetasTest | 1 | 2 | 4 | Row Total |
## --------------|-----------|-----------|-----------|-----------|
## 1 | 1 | 3 | 0 | 4 |
## | 0.250 | 0.750 | 0.000 | 0.333 |
## | 0.250 | 0.429 | 0.000 | |
## | 0.083 | 0.250 | 0.000 | |
## --------------|-----------|-----------|-----------|-----------|
## 2 | 1 | 2 | 1 | 4 |
## | 0.250 | 0.500 | 0.250 | 0.333 |
## | 0.250 | 0.286 | 1.000 | |
## | 0.083 | 0.167 | 0.083 | |
## --------------|-----------|-----------|-----------|-----------|
## 3 | 0 | 2 | 0 | 2 |
## | 0.000 | 1.000 | 0.000 | 0.167 |
## | 0.000 | 0.286 | 0.000 | |
## | 0.000 | 0.167 | 0.000 | |
## --------------|-----------|-----------|-----------|-----------|
## 4 | 2 | 0 | 0 | 2 |
## | 1.000 | 0.000 | 0.000 | 0.167 |
## | 0.500 | 0.000 | 0.000 | |
## | 0.167 | 0.000 | 0.000 | |
## --------------|-----------|-----------|-----------|-----------|
## Column Total | 4 | 7 | 1 | 12 |
## | 0.333 | 0.583 | 0.083 | |
## --------------|-----------|-----------|-----------|-----------|
##
## Como se puede observar, la mejor predicción la hemos hecho con K = 8
Random Forest
Ahora voy a implementar una solución mediante Random Forest:
Lo primero que hacemos es importar el paquete de Random Forest
#install.packages("randomForest")
library(randomForest)## Warning: package 'randomForest' was built under R version 3.5.2## randomForest 4.6-14## Type rfNews() to see new features/changes/bug fixes.##
## Attaching package: 'randomForest'## The following object is masked from 'package:ggplot2':
##
## marginUna vez instalado e importado, lo que tengo que hacer es crear el Random Forest, y ejecutarlo…
model <- randomForest(grupo ~ ., data = dataset[2:26], importance = TRUE)## Warning in randomForest.default(m, y, ...): The response has five or fewer unique values. Are you
## sure you want to do regression?model##
## Call:
## randomForest(formula = grupo ~ ., data = dataset[2:26], importance = TRUE)
## Type of random forest: regression
## Number of trees: 500
## No. of variables tried at each split: 8
##
## Mean of squared residuals: 1.300002
## % Var explained: -25.07Ahora lo voy a hacer con 10 fold X Validation:
result <- rfcv(dataset[2:26], dataset$grupo, cv.fold=10)## Warning in randomForest.default(trainx[idx != i, , drop = FALSE], trainy[idx != : The response has
## five or fewer unique values. Are you sure you want to do regression?## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?## Warning in randomForest.default(trainx[idx != i, , drop = FALSE], trainy[idx != : The response has
## five or fewer unique values. Are you sure you want to do regression?## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?## Warning in randomForest.default(trainx[idx != i, , drop = FALSE], trainy[idx != : The response has
## five or fewer unique values. Are you sure you want to do regression?## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?## Warning in randomForest.default(trainx[idx != i, , drop = FALSE], trainy[idx != : The response has
## five or fewer unique values. Are you sure you want to do regression?## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?## Warning in randomForest.default(trainx[idx != i, , drop = FALSE], trainy[idx != : The response has
## five or fewer unique values. Are you sure you want to do regression?## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?## Warning in randomForest.default(trainx[idx != i, , drop = FALSE], trainy[idx != : The response has
## five or fewer unique values. Are you sure you want to do regression?## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?## Warning in randomForest.default(trainx[idx != i, , drop = FALSE], trainy[idx != : The response has
## five or fewer unique values. Are you sure you want to do regression?## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?## Warning in randomForest.default(trainx[idx != i, , drop = FALSE], trainy[idx != : The response has
## five or fewer unique values. Are you sure you want to do regression?## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?## Warning in randomForest.default(trainx[idx != i, , drop = FALSE], trainy[idx != : The response has
## five or fewer unique values. Are you sure you want to do regression?## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?## Warning in randomForest.default(trainx[idx != i, , drop = FALSE], trainy[idx != : The response has
## five or fewer unique values. Are you sure you want to do regression?## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?head(result)## $n.var
## [1] 25 12 6 3 1
##
## $error.cv
## 25 12 6 3 1
## 3.208796e-01 3.097547e-01 1.998264e-01 2.998491e-01 3.104478e-06
##
## $predicted
## $predicted$`25`
## [1] 1.911228 1.889493 2.053748 3.194816 1.993456 3.454790 3.013546 1.596576 2.066019 2.001911
## [11] 1.964798 1.952699 1.847331 2.377325 1.952394 3.353029 2.922050 1.734196 2.019650 2.048404
## [21] 2.203528 2.730009 1.523295 2.780449 1.794750 2.687337 3.021453 3.032395 2.083081 1.968422
## [31] 1.817130 3.052378 1.881143 1.825082 2.041500 1.794780 1.959880 2.816587 1.883213 1.352543
## [41] 2.817969 1.518358 1.401569 1.859644 1.965140 1.876932 3.322712 1.867018 1.937511 1.980917
## [51] 2.850439 1.623201 1.944705 3.082983 1.850003 1.642996 2.711429 1.643585 3.221686 2.081161
## [61] 2.010151 1.745720 2.603810 2.241371 2.975127 1.904385 1.726961
##
## $predicted$`12`
## [1] 1.844828 1.798270 2.028974 3.412693 2.007508 3.474632 3.069027 1.578506 2.157454 1.945609
## [11] 1.869150 1.796068 1.861212 2.402384 1.933052 3.451468 2.900216 1.731967 2.049997 2.042698
## [21] 2.136141 2.648370 1.583308 2.564993 1.735021 2.689235 3.195244 3.036677 1.999896 1.975450
## [31] 1.756017 2.821132 1.913779 1.800043 2.024169 1.881803 1.977085 2.824338 1.991391 1.451588
## [41] 2.662274 1.541921 1.395567 1.796751 1.864090 1.986493 3.429379 1.802505 1.607276 1.934233
## [51] 2.753176 1.530196 2.022281 2.862084 1.735224 1.719136 2.634939 1.669217 3.488425 2.051781
## [61] 1.888223 1.784504 2.530647 2.164008 2.809493 1.950233 1.703831
##
## $predicted$`6`
## [1] 1.592432 1.743673 2.033003 3.502995 2.065875 3.734690 3.207858 1.576248 2.034765 2.039251
## [11] 1.732108 1.652583 1.845154 2.330557 1.594118 3.591409 3.032647 1.911301 2.065875 2.032796
## [21] 1.971400 2.723350 1.549724 2.766699 1.526846 2.779617 3.286085 3.412020 1.914594 1.957449
## [31] 1.732108 2.930475 1.971400 1.878993 2.039251 1.866578 1.878993 2.930475 1.938345 1.306269
## [41] 2.879000 1.277077 1.281495 1.741333 1.859444 1.802477 3.582301 1.849101 1.422451 1.915159
## [51] 3.075858 1.388837 2.004367 2.807077 1.597827 1.408841 2.695475 1.580523 3.509267 1.985990
## [61] 1.891887 1.486845 2.443987 1.950499 3.112254 1.908552 1.576293
##
## $predicted$`3`
## [1] 1.706758 1.765320 2.034652 3.169011 2.000368 3.278093 2.956017 1.684297 2.027536 2.028642
## [11] 1.687947 1.548105 1.858142 2.580313 1.730009 3.307245 3.297005 1.992753 2.000368 1.999745
## [21] 2.011578 2.770886 1.684297 2.621667 1.692552 2.644790 3.321582 3.214922 2.044898 1.981456
## [31] 1.687947 2.759992 2.011578 2.028642 2.028642 1.858142 2.028642 2.759992 1.992753 1.544904
## [41] 3.045846 1.491853 1.538252 1.687947 1.907769 1.837746 3.335858 1.992753 1.740898 1.942044
## [51] 3.128319 1.740898 1.992753 2.933011 1.701953 1.541332 2.895995 1.740898 3.335858 1.922527
## [61] 2.044898 1.599085 2.580501 2.037953 2.623670 1.841813 1.692552
##
## $predicted$`1`
## [1] 1.000 2.000 2.000 4.000 2.000 4.000 4.000 1.000 2.000 2.000 2.000 1.000 2.000 1.000 1.000 4.000
## [17] 4.000 2.000 2.000 2.000 2.000 2.998 1.000 4.000 1.000 2.998 4.000 4.000 2.000 2.000 2.000 2.998
## [33] 2.000 2.000 2.000 2.000 2.000 2.998 2.000 1.000 3.000 1.000 1.000 2.000 2.000 2.000 4.000 2.000
## [49] 1.000 2.000 4.000 1.000 2.000 2.992 1.000 1.000 2.992 1.000 4.000 2.000 2.000 1.000 2.992 2.000
## [65] 4.000 2.000 1.000Podemos ver el error, bajo la variable $error.cv, y podemos ver las predicciones que se han hecho para cada una de las n.var.
SVM de Kernel Lineal
Lo bueno que tiene SVM es que es muy robusto frente a la dimensión, por lo que deberíamos de obtener a priori buenos resultados con este método.
Lo primero que hay que hacer es importar la librería…
#install.packages("e1071")
library("e1071")## Warning: package 'e1071' was built under R version 3.5.2Con este método no necesito tener un conjunto de entrenaminento y otro de test, por lo que sigo adelante.
Ahora que hemos instalado la librería, vamos a crear el SVM:
modelo_svm <- svm(grupo ~ ., data=dataset[2:26], kernel="linear")
summary(modelo_svm)##
## Call:
## svm(formula = grupo ~ ., data = dataset[2:26], kernel = "linear")
##
##
## Parameters:
## SVM-Type: eps-regression
## SVM-Kernel: linear
## cost: 1
## gamma: 0.04166667
## epsilon: 0.1
##
##
## Number of Support Vectors: 64Ahora que tenemos creado este primer modelo, toca predecir:
prediccion <- predict(modelo_svm,dataset[,2:25])
prediccion## 1 2 3 4 5 6 7 8 9 10 11
## 2.710785 1.167141 2.103294 2.272653 1.921987 2.951614 2.215446 1.903501 2.343303 2.364138 1.624035
## 12 13 14 15 16 17 18 19 20 21 22
## 1.264225 1.134063 3.102210 1.472399 3.897730 2.237491 1.897509 2.142401 1.897167 2.651879 1.472399
## 23 24 25 26 27 28 29 30 31 32 33
## 1.102637 1.498541 1.595378 2.586326 3.896878 2.912379 1.897073 2.064304 1.392893 2.897015 2.102379
## 34 35 36 37 38 39 40 41 42 43 44
## 1.897257 2.712875 1.764464 1.925354 2.268604 1.897013 1.237698 1.952647 1.724457 2.010257 2.102934
## 45 46 47 48 49 50 51 52 53 54 55
## 2.102424 2.102300 2.865796 2.103005 2.080632 2.155359 1.844763 2.016170 1.897797 2.896991 2.171207
## 56 57 58 59 60 61 62 63 64 65 66
## 2.075540 2.088427 1.103007 2.142982 2.187305 2.102484 2.155098 2.270547 2.102423 3.897624 2.103058
## 67
## 2.053638El problema que tenemos con estas predicciones es que están siendo contínuas, y no discretas, por lo que las voy a discretizar redondeando:
prediccion <- round(prediccion, digits = 0) #No quiero dígitos decimales
prediccion## 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33
## 3 1 2 2 2 3 2 2 2 2 2 1 1 3 1 4 2 2 2 2 3 1 1 1 2 3 4 3 2 2 1 3 2
## 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66
## 2 3 2 2 2 2 1 2 2 2 2 2 2 3 2 2 2 2 2 2 3 2 2 2 1 2 2 2 2 2 2 4 2
## 67
## 2Ahora que hemos predicho, tenemos que sacar la matriz de confusión:
matriz.conf <- table(prediccion, dataset[,26])
matriz.conf##
## prediccion 1 2 3 4
## 1 5 3 1 1
## 2 10 25 4 5
## 3 2 2 3 3
## 4 0 0 0 3sum(diag(matriz.conf))/67## [1] 0.5373134Obtenemos un porcentaje de acierto medio, pero esto es sin tener en cuenta que los pacientes del grupo 2 pueden pertenecer al 1, lo cual suma alrededor de 10 pacientes más, por lo que obtendríamos valores mucho más altos que rondarían el 65-70% de acierto.
SVM de Kernel RBF
modelo_svm.radial <- svm(grupo ~ ., data=dataset[2:26], kernel="radial")
summary(modelo_svm.radial)##
## Call:
## svm(formula = grupo ~ ., data = dataset[2:26], kernel = "radial")
##
##
## Parameters:
## SVM-Type: eps-regression
## SVM-Kernel: radial
## cost: 1
## gamma: 0.04166667
## epsilon: 0.1
##
##
## Number of Support Vectors: 60Ahora que tenemos creado este primer modelo, toca predecir:
prediccion.radial <- predict(modelo_svm.radial,dataset[,2:25])
prediccion.radial## 1 2 3 4 5 6 7 8 9 10 11
## 1.549973 1.897491 2.102992 2.931869 1.958610 2.933492 2.460079 1.968849 2.102839 2.102609 2.102858
## 12 13 14 15 16 17 18 19 20 21 22
## 1.834806 1.897158 1.792309 2.081453 3.345387 2.644334 1.896957 2.102818 2.101751 2.102659 2.081453
## 23 24 25 26 27 28 29 30 31 32 33
## 1.102789 2.171444 1.688974 2.247323 3.098435 2.310026 2.102645 2.090946 1.897066 2.757770 2.102934
## 34 35 36 37 38 39 40 41 42 43 44
## 1.935061 2.103190 1.897447 2.078152 2.427070 1.897235 1.396473 2.724358 1.577114 1.558528 1.911562
## 45 46 47 48 49 50 51 52 53 54 55
## 2.102722 2.093837 2.558446 2.102649 1.964595 2.102263 1.784159 1.755280 2.102747 2.897155 1.865630
## 56 57 58 59 60 61 62 63 64 65 66
## 1.404453 2.647560 1.341993 2.806776 2.103103 2.102609 1.945673 2.749015 2.102654 3.127086 2.102353
## 67
## 1.482761El problema que tenemos con estas predicciones es que están siendo contínuas, y no discretas, por lo que las voy a discretizar redondeando:
prediccion.radial <- round(prediccion.radial, digits = 0)
prediccion.radial## 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33
## 2 2 2 3 2 3 2 2 2 2 2 2 2 2 2 3 3 2 2 2 2 2 1 2 2 2 3 2 2 2 2 3 2
## 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66
## 2 2 2 2 2 2 1 3 2 2 2 2 2 3 2 2 2 2 2 2 3 2 1 3 1 3 2 2 2 3 2 3 2
## 67
## 1Ahora que hemos predicho, tenemos que sacar la matriz de confusión:
matriz.conf.radial <- table(prediccion.radial, dataset[,26])
matriz.conf.radial##
## prediccion.radial 1 2 3 4
## 1 5 0 0 0
## 2 12 30 3 4
## 3 0 0 5 8sum(diag(matriz.conf.radial))/67## [1] 0.5970149Obtenemos un acierto del 60%, al que hay que sumar otros 12 pacientes. ### Si añadimos estos pacientes, nos encontramos con un acierto del 77% Por lo tanto, SVM de Kernel radial es una buena técnica para la predicción en este problema.
Ahora pasamos a los modelos de inteligencia artificial no supervisados:
Modelos de inteligencia artificial no supervisados
El primer modelo de inteligencia artificial no supervisado que voy a usar es un modelo de clustering llamado Dendrograma.
Dendrograma
Para esto, lo que voy a hacer es dividirlo en 4 clusters, coincidiendo con los 4 grupos de trastornos que tengo.
#install.packages("ape")
library(ape)## Warning: package 'ape' was built under R version 3.5.2dd <- dist(scale(dataset[,2:25]), method = "euclidean") #Nos basamos en la distancia euclídea
hier.clust <- hclust(dd, method = "ward.D2")
colores.dendrograma <- c("red", "orange", "green", "black") # Creamos los colores con los que queremos el cluster
cluster.4 <- cutree(hier.clust, 4) # Cluster jerárquico de 4...
plot(as.phylo(hier.clust), type = "fan", tip.color = colores.dendrograma[cluster.4], label.offset = 0.3, cex = 0.8) #Lo pintamos
Como vemos, estamos obteniendo el indentificador de cada paciente en el dendrograma, donde los pacientes que mas se parecen estarán más juntos, mientras que los que menos se parecen estarán más separados. Es interesante analizar como los pacientes verdes y los naranjas surgen de la misma salida del centro, cosa que no ocurre con los rojos y los negros, lo cual quiere decir que algo tienen en común estos dos tipos de casos.
Ahora voy a hacer el mismo dendrograma pero con el DataSet de centrado y escalado, de tal manera que veamos a ver si hay diferencias:
dd <- dist(scale(matriz.pacientes.datos.centscal), method = "euclidean")
hier.clust <- hclust(dd, method = "ward.D2")
colores.dendrograma <- c("red", "orange", "green", "black")
cluster.4 <- cutree(hier.clust, 4)
plot(as.phylo(hier.clust), type = "fan", tip.color = colores.dendrograma[cluster.4], label.offset = 0.3, cex = 0.8)
Si lo comparamos, vemos que hemos obtenido exactamente el mismo resultado, por lo que en este caso el centrado y escalado no es necesario.
Vamos a analizar algunos pacientes aleatoriamente para ver si ha acertado, o al menos si se ha aproximado:
- Paciente 1: Analizado - Rojo ——— Real: 1
- Paciente 2: Analizado - Naranja —— Real: 2
- Paciente 3: Analizado - Naranja —— Real: 2
- Paciente 4: Analizado - Verde ——– Real: 4
- Paciente 5: Analizado - Naranja —— Real: 2
- Paciente 27: Analizado - Negro ——- Real: 4
Es decir, a la vista de estos resultados, podemos concluir que el grupo 1 es el de los pacientes en rojo, el grupo 2 es el de los pacientes en naranja, y luego entre el grupo 3 y el grupo 4 hay dudas, pero teniendo varios pacientes tanto del grupo 3 como del grupo 4 en nuestro DataSet parece ser que algo de error ha cometido.
K-Means
El algoritmo KMeans en principio no es el algoritmo más adecuado para este trabajo, ya que se basa en círculos para la clasificación de los individuos, cuando en principio en mis datos esto no es así. De todas formas, voy a clasificar a los pacientes siguiendo este algoritmo para comprobar la eficacia que tiene sobre mi problema:
#install.packages("cluster")
#install.packages("fpc")
library(cluster)
library(fpc)## Warning: package 'fpc' was built under R version 3.5.2Hacemos el clustering y vemos algunos resultados:
datos.kmeans <- matriz.pacientes.datos # Sin la clasificación dentro del dataset
clusters <- kmeans(datos.kmeans, centers=4)
clusters$centers## edad sex rel_ctxo_rel_mala rel_ctxo_trauma rel_ctxo_buena ed_perm ed_norm
## 1 23.82609 0.1739130 0.08695652 0.3043478 0.6086957 0.08695652 0.6956522
## 2 30.94118 0.1176471 0.17647059 0.3529412 0.4705882 0.11764706 0.6470588
## 3 16.61111 0.2777778 0.05555556 0.3888889 0.5555556 0.61111111 0.1666667
## 4 44.44444 0.3333333 0.33333333 0.4444444 0.2222222 0.44444444 0.3333333
## ed_estr resil_ba resil_me resil_al pen_dic gen_ex etiq fil_men max_min
## 1 0.2173913 0.4782609 0.52173913 0.0000000 0.9130435 0.9565217 1.0000000 0.7826087 0.9565217
## 2 0.2352941 0.4705882 0.52941176 0.0000000 0.9411765 1.0000000 0.5882353 0.8235294 1.0000000
## 3 0.2222222 0.9444444 0.05555556 0.0000000 0.8333333 0.9444444 0.7777778 0.7222222 0.9444444
## 4 0.2222222 0.2222222 0.66666667 0.1111111 0.8888889 0.8888889 0.3333333 0.8888889 1.0000000
## conc_arb pseu_res deb raz_emo inhib asert agres impuls
## 1 1.0000000 0.6956522 1.0000000 0.9130435 0.7826087 0.08695652 0.1304348 0.5652174
## 2 1.0000000 0.6470588 1.0000000 0.7058824 0.5294118 0.23529412 0.2352941 0.7647059
## 3 0.9444444 0.2222222 0.7777778 0.8333333 0.6666667 0.00000000 0.3333333 0.5000000
## 4 1.0000000 0.3333333 1.0000000 0.5555556 0.5555556 0.33333333 0.1111111 0.6666667clusters$cluster## [1] 3 3 1 3 1 1 1 1 1 3 2 3 1 3 3 3 4 1 1 1 1 3 4 1 4 3 3 1 4 3 2 1 2 1 3 1 3 2 2 2 2 1 1 3 4 4 2 1
## [49] 2 2 2 2 4 3 3 4 2 2 3 1 1 2 2 1 2 4 1Interpretando estos resultados, obtenemos:
El cluster 1 destaca por sexo más hacia masculino que otros, una relación contexto ciertamente buena, una educación permisiva, una resiliencia baja, maximización y minimización, razonamiento emocional, cierta inhibición y poca agresividad.
El cluster 2 destaca por una edad mayor, es el cluster con mejor relación con el contexto, y suelen tener las personas de este cluster una educación normal. Destaca por una resiliencia media, pensamiento dicotómico, generalización excesiva, etiquetado, conclusiones arbitrarias, deberías, razonamiento emocional e inhibición.
El cluster número 3 destaca por tener una edad aún más elevada, más ratio de personas del sexo femenino que ningún otro cluster, y tienen una relación con el contexto bastante variable. La educación de estas personas es principalmente normal, con una resiliencia que puede ser tanto baja como media. Destacan por el pensamiento dicotómico, generalización excesiva, poco etiquetado, maximización y minimización, filtro mental, conclusiones arbitrarias, pseudoresponsabilidad, deberías, y suelen ser bastante inhibidos e impulsivos.
Finalmente, el cluster 4 destaca por ser el que tiene la edad más elevada y el ratio de sexo más masculino. La relación con el contexto de estos individuos clasificados en este grupo es principalmente de trauma, aunque también hay buenas y malas. La educación de estos individuos es principalmente permisiva, y la resiliciencia tiende a media. Destacan por la poca etiquetación que hacen, pero un gran fitro mental, conclusiones arbitrarias, poca pseudo-responsabilidad, muchos deberías, poco razonamiento emocional, y son principalmente inhibidos e impulsivos.
Ahora sacamos la gráfica para poder ver como los ha clasificado sobre dos componentes principales artificiales:
clusplot(datos.kmeans, clusters$cluster, color = TRUE, main = "Representación 2D con Clusplot", labels = 4, xlab = "Componente 1", ylab = "Componente 2") # Con las dos componentes principales que más explicación nos dan